home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / LOPASS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-28  |  5.7 KB  |  206 lines
  1. 10  'LOPASS - SALLEN and KEY Lowpass Active Filter - 30 OCT 95 rev. 27 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  PI=3.14159
  6. 60  U1$="#####.###"
  7. 70  UL$=STRING$(80,205)
  8. 80  E$=STRING$(79,32)
  9. 90  '
  10. 100  '.....start
  11. 110  COLOR 15,2
  12. 120  FOR Z=1 TO 2:PRINT STRING$(80,32);:NEXT Z
  13. 130  LOCATE 1,2
  14. 140  PRINT "THIRD ORDER SALLEN & KEY LOWPASS ACTIVE FILTER";
  15. 150  PRINT " with single rail DC supply";
  16. 160  LOCATE 2,2:PRINT "by Brian Egan ZL1LE"
  17. 170  LOCATE 2,38:PRINT "edited for HAMCALC by George Murphy VE3ERP"
  18. 180  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  19. 190  GOSUB 1690  'draw diagram
  20. 200  PRINT UL$;
  21. 210  '
  22. 220  '.....input data
  23. 230  PRINT " Press number in < > to select filter type:"
  24. 240  PRINT UL$;
  25. 250  PRINT "   <1>  BUTTERWORTH"
  26. 260  PRINT "   <2>  CHEBYSHEV"
  27. 270  PRINT UL$;
  28. 280  PRINT "    or Press <0> to EXIT"
  29. 290  F$=INKEY$
  30. 300  IF F$="0" THEN CLS:RUN EX$
  31. 310  IF F$="1" THEN N$=" BUTTERWORTH LOWPASS FILTER ":GOSUB 1210:GOTO 400
  32. 320  IF F$="2" THEN N$=" CHEBYSHEV LOWPASS FILTER ":GOSUB 1370:GOTO 400
  33. 330  GOTO 290
  34. 340  '
  35. 350  '.....format input line
  36. 360  LOCATE CSRLIN-1:PRINT SPC(10);
  37. 370  LOCATE CSRLIN,50:PRINT STRING$(7,".");USING U1$;ZZ;
  38. 380  RETURN
  39. 390  '
  40. 400  '.....calculate component values
  41. 410  A1=1/RP+QUOT/WP2:A2=1/WP2+QUOT/RP/WP2:A3=1/RP/WP2
  42. 420  X0=A1/2:P=A1*A2-A3:ITER=1
  43. 430  U1=A1-X0:U2=A2+2*U1*U1
  44. 440  F=X0-P/U2:DF=1-4*P*U1/U2^2
  45. 450  X1=X0-F/DF
  46. 460  IF ABS(X1-X0)<10^-8 THEN 480
  47. 470  X0=X1:GOTO 430
  48. 480  T3=X1
  49. 490  R3C=T3*10^6
  50. 500  PRINT TAB(12);"Product of R3 (K-) x C (nF)..................";USING U1$;R3C
  51. 510  LN=CSRLIN
  52. 520  '
  53. 530  INPUT "    ENTER: Value of C..............................(nF)";C
  54. 540  ZZ=C:GOSUB 350:PRINT " nF"
  55. 550  R3=T3*10^6/C:T1=A1-T3:R1=T1*10^6/C:T2=A3/T3/(A1-T3):R2=T2*10^6/C
  56. 560  '
  57. 570  Y=2*R1
  58. 580  PRINT TAB(12);"Value of R1a, R1b............................";USING U1$;Y;
  59. 590  PRINT " K-"
  60. 600  '
  61. 610  PRINT TAB(12);"Value of R2..................................";USING U1$;R2;
  62. 620  PRINT " K-"
  63. 630  '
  64. 640  PRINT TAB(12);"Value of R3..................................";USING U1$;R3;
  65. 650  PRINT " K-"
  66. 660  '
  67. 670  LOCATE 25,17
  68. 680  COLOR 0,7:PRINT " Do you wish to vary the filter design?   (y/n) ";
  69. 690  COLOR 7,0
  70. 700  Y$=INKEY$:IF Y$=""THEN 700
  71. 710  IF Y$="y" OR Y$="Y" THEN 720 ELSE GOTO 760
  72. 720  VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN+2
  73. 730  PRINT TAB(12);"(Previous selection for C was";C;" nF)"
  74. 740  LOCATE LN:GOTO 530
  75. 750  '
  76. 760  LOCATE 25,1:PRINT E$;
  77. 770  GOSUB 1930   'hard copy option
  78. 780  LOCATE 25,1:PRINT E$;
  79. 790  LOCATE 25,12:COLOR 0,7
  80. 800  PRINT " Press 1 to QUIT, or 2 to tabulate filter response ......";
  81. 810  COLOR 7,0
  82. 820  Y$=INKEY$:IF Y$="" THEN 820
  83. 830  IF Y$="1"THEN 1900
  84. 840  IF Y$="2"THEN 870
  85. 850  GOTO 820
  86. 860  '
  87. 870  '.....filter frequency response
  88. 880  CLS:COLOR 7,0
  89. 890  LOCATE 1,8
  90. 900  PRINT "THIRD ORDER SALLEN & KEY LOWPASS ACTIVE FILTER FREQUENCY RESPONSE"
  91. 910  PRINT UL$;
  92. 920  PRINT TAB(T);N$
  93. 930  PRINT UL$;
  94. 940  PRINT TAB(4);
  95. 950  PRINT "FREQUENCY (Hz)";TAB(22);"RESPONSE (dB)";TAB(42);"FREQUENCY (Hz)";
  96. 960  PRINT TAB(60);"RESPONSE (dB)"
  97. 970  PRINT TAB(4);
  98. 980  PRINT "SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";TAB(22);"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";TAB(42);"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";
  99. 990  PRINT TAB(60);"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND"
  100. 1000  K1=K*WP^3
  101. 1010  F1=INT(FP/10):FF=INT((FP-F1)/13):F2=FP
  102. 1020  '
  103. 1030    FOR FREQ=F1 TO F2 STEP FF
  104. 1040  W=2*PI*FREQ:RN=WP2-W^2:IN=QUOT*W
  105. 1050  AV=K1/SQR(RN^2+IN^2)/SQR(RP^2+W^2):DB=20*LOG(AV)/2.303
  106. 1060  PRINT TAB(9);:PRINT USING "####";FREQ;:PRINT TAB(25);USING "###.##";DB
  107. 1070    NEXT FREQ
  108. 1080  '
  109. 1090  N=1:F1=FP:F2=5*FP
  110. 1100  '
  111. 1110    FOR FREQ=F1 TO F2 STEP INT((F2-F1)/13)
  112. 1120  W=2*PI*FREQ:RN=WP2-W^2:IN=QUOT*W
  113. 1130  AV=K1/SQR(RN^2+IN^2)/SQR(RP^2+W^2):DB=20*LOG(AV)/2.303
  114. 1140  LOCATE 6+N,46:PRINT USING "#####";FREQ;:PRINT TAB(63);USING "###.##";DB
  115. 1150  N=N+1
  116. 1160    NEXT FREQ
  117. 1170  '
  118. 1180  GOSUB 1930
  119. 1190  GOTO 1900
  120. 1200  '
  121. 1210  '.....Butterworth filter design
  122. 1220  VIEW PRINT 2 TO 24:CLS:VIEW PRINT
  123. 1230  LOCATE 2:COLOR 1,0:PRINT STRING$(80,223);
  124. 1240  GOSUB 1690
  125. 1250  T=(80-LEN(N$))/2
  126. 1260  COLOR 0,7:LOCATE CSRLIN,T:PRINT N$:COLOR 7,0
  127. 1270  INPUT "    ENTER: Filter passband width...................(Hz)";FP
  128. 1280  ZZ=FP:GOSUB 350:PRINT " Hz"
  129. 1290  INPUT "    ENTER: Falloff in response at passband edge....(dB)";ADB
  130. 1300  ZZ=ADB:GOSUB 350:PRINT " dB"
  131. 1310  EPSILON=SQR(10^(ADB/10)-1)
  132. 1320  FACTOR=1/(EPSILON^(1/3))
  133. 1330  WP=2*PI*FP
  134. 1340  RP=FACTOR*WP:QUOT=RP:WP2=RP^2:K=1/EPSILON
  135. 1350  RETURN
  136. 1360  '
  137. 1370  '     Chebyshev filter design
  138. 1380  VIEW PRINT 2 TO 24:CLS:VIEW PRINT
  139. 1390  LOCATE 2:COLOR 1,0:PRINT STRING$(80,223);
  140. 1400  GOSUB 1690
  141. 1410  T=(80-LEN(N$))/2
  142. 1420  COLOR 0,7:LOCATE CSRLIN,T:PRINT N$:COLOR 7,0
  143. 1430  INPUT "    ENTER: Filter passband width...................(Hz)";FP
  144. 1440  ZZ=FP:GOSUB 350:PRINT " Hz"
  145. 1450  INPUT "    ENTER: Passband ripple (0.5, 1.0 or 2.0).......(dB)";ADB
  146. 1460  IF ADB=0.5 OR ADB=1 OR ADB=2 THEN 1480
  147. 1470  BEEP:LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1450
  148. 1480  ZZ=ADB:GOSUB 350
  149. 1490  LOCATE CSRLIN,28:PRINT ".................";
  150. 1500  LOCATE CSRLIN,66:PRINT " dB"
  151. 1510  WP=2*PI*FP
  152. 1520  IF ADB = 0.5 THEN GOSUB 1570
  153. 1530  IF ADB=1 THEN GOSUB 1610
  154. 1540  IF ADB=2 THEN GOSUB 1650
  155. 1550  RETURN
  156. 1560  '
  157. 1570  '.....ADB= O.5 dB
  158. 1580  RP=WP*0.62646:QUOT=WP*0.62646:WP2=1.14245*WP^2:K=0.7157
  159. 1590  RETURN
  160. 1600  '
  161. 1610  '.....ADB=1 dB
  162. 1620  RP=WP*0.49417:QUOT=WP*0.49417:WP2=0.9942*WP^2:K=0.4913
  163. 1630  RETURN
  164. 1640  '
  165. 1650  '.....ADB=2 dB
  166. 1660  RP=WP*0.36891:QUOT=WP*0.36891:WP2=0.8861*WP^2:K=0.32689
  167. 1670  RETURN
  168. 1680  '
  169. 1690  '......schematic diagram
  170. 1700  COLOR 0,7
  171. 1710  T=12
  172. 1720  LOCATE,T:PRINT "       R6 100 K                                          "
  173. 1730  LOCATE,T:PRINT "      VARPTRSOUNDSOUND\/\/\SOUNDBSAVESOUNDSOUNDSOUND + V                 C                "
  174. 1740  LOCATE,T:PRINT "   C1 CALL VARPTRSOUNDSOUNDSOUNDSOUNDCOLOR CALL               VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR      "
  175. 1750  LOCATE,T:PRINT " DEFDBLSOUNDUSINGSOUNDBSAVEMOTORSOUND<0xB4!>2  8BLOADSOUND'  R1a     R2   CALL  R3       VARPTRSOUNDSOUNDSOUNDSOUNDCOLOR CALL      "
  176. 1760  LOCATE,T:PRINT "  1>FCALL U1a  1BLOADSOUNDBSAVESOUND\/\/\SOUNDBSAVESOUND\/\/\SOUNDMOTORSOUND\/\/\SOUNDBSAVESOUNDSOUNDSOUND<0xB4!>5   CALL CALL  C2  "
  177. 1770  LOCATE,T:PRINT "     CALL VARPTR<0xB4!>3   CALL CALL       CALL   C       C   CALL  U1b  7BLOADSOUNDMOTORBSAVESOUNDUSINGSOUNDDEFDBL "
  178. 1780  LOCATE,T:PRINT "     CALL CALLCLS-4BSAVESOUND' CALL       BLOADSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND' VARPTRSOUND<0xB4!>6   CALL  CALL1>F  "
  179. 1790  LOCATE,T:PRINT "     CALL CALL  \\\  CALL       CALL       CALL         CALL CLSSOUNDSOUNDSOUNDSOUND'  CALL     "
  180. 1800  LOCATE,T:PRINT "     CALL CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'  R1b  CALL       CALL   R5    CALL   R4    CALL     "
  181. 1810  LOCATE,T:PRINT "     CLSSOUNDSOUNDSOUND\/\/\SOUNDBSAVESOUND\/\/\SOUND'       BLOADSOUNDSOUND\/\/\SOUNDSOUNDMOTORSOUNDSOUND\/\/\SOUNDSOUND'     "
  182. 1820  LOCATE,T:PRINT "      R7 100 K CALL               CALL   10 K      10 K        "
  183. 1830  LOCATE,T:PRINT "              \\\             \\\                        "
  184. 1840  LOCATE,T:PRINT "           U1a, U1b = Dual op-amp (e.g. 1458)            "
  185. 1850  COLOR 7,0
  186. 1860  RETURN
  187. 1870  '
  188. 1880  '.....end
  189. 1890  GOSUB 1930
  190. 1900  CLS:GOTO 100
  191. 1910  END
  192. 1920  '
  193. 1930  'HARDCOPY
  194. 1940  GOSUB 2050:LOCATE 25,2:COLOR 14,6
  195. 1950  PRINT " Press 1 to print screen, 2 to print screen & ";
  196. 1960  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  197. 1970  Z$=INKEY$:IF Z$="3"THEN GOSUB 2050:RETURN
  198. 1980  IF Z$="1"OR Z$="2"THEN GOSUB 2050:GOTO 2000
  199. 1990  GOTO 1970
  200. 2000  FOR QX=1 TO 24:FOR QY=1 TO 80
  201. 2010  LPRINT CHR$(SCREEN(QX,QY));
  202. 2020  NEXT QY:NEXT QX
  203. 2030  IF Z$="2"THEN LPRINT CHR$(12)
  204. 2040  GOTO 1940
  205. 2050  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  206.